home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt32s3.arc / RECEIVEX.PAS < prev    next >
Pascal/Delphi Source File  |  1985-11-02  |  53KB  |  1,466 lines
  1. (*----------------------------------------------------------------------*)
  2. (*           Receive_Xmodem_File --- Download file using XMODEM         *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Receive_Xmodem_File( Use_CRC : BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Receive_Xmodem_File                                  *)
  10. (*                                                                      *)
  11. (*     Purpose:    Downloads file from remote host using XMODEM         *)
  12. (*                 protocol.                                            *)
  13. (*                                                                      *)
  14. (*     Calling Sequence:                                                *)
  15. (*                                                                      *)
  16. (*        Receive_Xmodem_File( Use_CRC );                               *)
  17. (*                                                                      *)
  18. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  19. (*                       of XMODEM; FALSE to use Checksum version.      *)
  20. (*                                                                      *)
  21. (*     Remarks:                                                         *)
  22. (*                                                                      *)
  23. (*        The transmission parameters are automatically set to:         *)
  24. (*                                                                      *)
  25. (*               Current baud rate, 8 bits, No parity, 1 stop           *)
  26. (*                                                                      *)
  27. (*        and then they are automatically restored to the previous      *)
  28. (*        values when the transfer is complete.                         *)
  29. (*                                                                      *)
  30. (*        This code actually controls file reception using any of the   *)
  31. (*        Xmodem-based protocols:  Xmodem, Modem7, Telink, and Ymodem.  *)
  32. (*                                                                      *)
  33. (*     Calls:   KeyPressed                                              *)
  34. (*              Async_Send                                              *)
  35. (*              Async_Receive                                           *)
  36. (*              Async_Receive_With_Timeout                              *)
  37. (*              Async_Purge_Buffer                                      *)
  38. (*              Compute_Crc                                             *)
  39. (*              Update_Xmodem_Receive_Display                           *)
  40. (*              Display_Receive_Error                                   *)
  41. (*              Receive_Xmodem_Sector                                   *)
  42. (*              Receive_Telink_Header                                   *)
  43. (*              Receive_Ymodem_Header                                   *)
  44. (*              Wait_For_SOH                                            *)
  45. (*              Set_File_Date_And_Time                                  *)
  46. (*              Draw_Menu_Frame                                         *)
  47. (*              Open_Receiving_File                                     *)
  48. (*              Write_File_Handle                                       *)
  49. (*              Close_File_Handle                                       *)
  50. (*                                                                      *)
  51. (*----------------------------------------------------------------------*)
  52.  
  53. CONST
  54.    Max_Errors       = 20           (* Maximum errors before aborting    *)
  55.                                    (* reception                         *);
  56. VAR
  57.    Sector_Count  : INTEGER         (* Sector count -- no wrap at 255    *);
  58.    Sector_Comp   : BYTE            (* Complement of current sector #    *);
  59.    Sector_Prev   : BYTE            (* Previous sector number            *);
  60.    I             : INTEGER         (* Loop index                        *);
  61.    Error_Count   : INTEGER         (* # of errors encountered           *);
  62.    Ch            : INTEGER         (* Character read from COM port      *);
  63.    Error_Flag    : BOOLEAN         (* IF an error is found              *);
  64.    Initial_Ch    : INTEGER         (* Initial character                 *);
  65.    Sector_Length : INTEGER         (* Sector Length                     *);
  66.    Sector_Prev1  : BYTE            (* Previous sector + 1               *);
  67.    BlockL_Errors : INTEGER         (* Counts block length errors        *);
  68.    SOH_Errors    : INTEGER         (* Counts SOH errors                 *);
  69.    BlockN_Errors : INTEGER         (* Counts block number errors        *);
  70.    Comple_Errors : INTEGER         (* Counts complement errors          *);
  71.    Timeout_Errors: INTEGER         (* Counts timeout errors             *);
  72.    Resend_Errors : INTEGER         (* Counts resend block errors        *);
  73.    CRC_Errors    : INTEGER         (* Counts checksum/crc errors        *);
  74.    Effective_Rate: REAL            (* Effective baud rate of transfer   *);
  75.    CRC_Tries     : INTEGER         (* Initial CRC tries                 *);
  76.    SOH_Time      : INTEGER         (* Seconds to wait for SOH           *);
  77.    RFile_Size    : REAL            (* Actual file size                  *);
  78.    RFile_Date    : REAL            (* File date/time                    *);
  79.    File_Date     : INTEGER         (* MS DOS encoded file date          *);
  80.    File_Time     : INTEGER         (* MS DOS encoded file time          *);
  81.    RFile_Name    : AnyStr          (* Received file name, Ymodem        *);
  82.    Truncate_File : BOOLEAN         (* TRUE to trunc. file to exact size *);
  83.    RFile_Open    : BOOLEAN         (* TRUE if receiving file opened     *);
  84.    XFile_Byte    : FILE OF BYTE    (* For truncating received file      *);
  85.    OK_Transfer   : BOOLEAN         (* If transfer OK                    *);
  86.    Block_Zero    : BOOLEAN         (* If block 0 encountered            *);
  87.  
  88.    RFile_Size_2  : REAL            (* File size from totalling sectors  *);
  89.    TName         : ShortStr        (* Transfer type                     *);
  90.  
  91.    Display_Time  : BOOLEAN         (* Display time remaining for trans. *);
  92.    Time_To_Send  : REAL            (* Time in seconds to transfer file  *);
  93.    Start_Time    : REAL            (* Starting time of transfer         *);
  94.    End_Time      : REAL            (* Ending time of transfer           *);
  95.    Time_Per_Block: REAL            (* Time for one block                *);
  96.    Blocks_To_Get : REAL            (* Number of blocks                  *);
  97.    Write_Count   : INTEGER         (* Number of bytes to write          *);
  98.    Err           : INTEGER         (* Error flag for handle I/O         *);
  99.  
  100.                                    (* Write buffer pointer              *)
  101.    Write_Buffer  : File_Handle_Buffer_Ptr;
  102.    Buffer_Pos    : INTEGER         (* Current buffer position           *);
  103.    Buffer_Length : INTEGER         (* Buffer length                     *);
  104.    Use_CRC_2     : BOOLEAN         (* TRUE to use CRC method            *);
  105.    Menu_Title    : AnyStr          (* Menu title                        *);
  106.    Alt_R_Pressed : BOOLEAN         (* TRUE if Alt-R cancelled download  *);
  107.    Long_Buffer   : BOOLEAN         (* TRUE if separate buffer used      *);
  108.  
  109. (*----------------------------------------------------------------------*)
  110. (*           Open_Receiving_File --- open file to receive download      *)
  111. (*----------------------------------------------------------------------*)
  112.  
  113. PROCEDURE Open_Receiving_File;
  114.  
  115. VAR
  116.    Err: INTEGER;
  117.  
  118. BEGIN (* Open_Receiving_File *)
  119.                                    (* Check if file name given yet. *)
  120.                                    (* If not, prompt for it.        *)
  121.  
  122.    IF FileName = '' THEN
  123.       BEGIN
  124.  
  125.          Window( 1, 1, 80, 25 );
  126.          GoToXY( 1 , 25 );
  127.          WRITE('Enter file name to receive download: ');
  128.          READLN( FileName );
  129.  
  130.       END;
  131.                                    (* Open reception file *)
  132.    IF ( NOT RFile_Open ) THEN
  133.       BEGIN
  134.  
  135.          Err := Create_File_Handle( FileName, Attribute_None, XFile_Handle );
  136.  
  137.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  138.             BEGIN
  139.  
  140.                GoToXY( 25 , 10 );
  141.                WRITE('Cannot open reception file, download cancelled.');
  142.                ClrEol;
  143.  
  144.                DELAY( One_Second_Delay );
  145.  
  146.                Stop_Receive := TRUE;
  147.  
  148.             END
  149.          ELSE
  150.             RFile_Open := TRUE;
  151.  
  152.       END;
  153.  
  154.    IF Rfile_Open THEN
  155.       Writelne('Receiving file ' + FileName, FALSE );
  156.  
  157. END   (* Open_Receiving_File *);
  158.  
  159. (*----------------------------------------------------------------------*)
  160. (*   Initialize_Receive_Display --- Set up display of Xmodem reception  *)
  161. (*----------------------------------------------------------------------*)
  162.  
  163. PROCEDURE Initialize_Receive_Display;
  164.  
  165. BEGIN (* Initialize_Receive_Display *)
  166.  
  167.    GoToXY( 1 , 1 );
  168.  
  169.    WRITE(' Blocks received      :');
  170.    ClrEol;
  171.  
  172.    GoToXY( 1 , 2 );
  173.    WRITE(' Block length errors  :');
  174.    ClrEol;
  175.  
  176.    GoToXY( 1 , 3 );
  177.    WRITE(' SOH errors           :');
  178.    ClrEol;
  179.  
  180.    GoToXY( 1 , 4 );
  181.    WRITE(' Block number errors  :');
  182.    ClrEol;
  183.  
  184.    GoToXY( 1 , 5 );
  185.    WRITE(' Complement errors    :');
  186.    ClrEol;
  187.  
  188.    GoToXY( 1 , 6 );
  189.    WRITE(' Timeout errors       :');
  190.    ClrEol;
  191.  
  192.    GoToXY( 1 , 7 );
  193.    WRITE(' Resend block errors  :');
  194.    ClrEol;
  195.  
  196.    GoToXY( 1 , 8 );
  197.  
  198.    IF ( NOT Use_Crc ) THEN
  199.       WRITE(' Checksum errors      :')
  200.    ELSE
  201.       WRITE(' CRC errors           :');
  202.  
  203.    ClrEol;
  204.  
  205.    GoToXY( 1 , 9 );
  206.  
  207.    IF Display_Time THEN
  208.       WRITE(' Approx. time left    :')
  209.    ELSE
  210.       WRITE(' ');
  211.  
  212.    ClrEol;
  213.  
  214.    GoToXY( 1 , 10 );
  215.    WRITE  (' Last status message  :');
  216.    ClrEol;
  217.  
  218. END   (* Initialize_Receive_Display *);
  219.  
  220. (*----------------------------------------------------------------------*)
  221. (*        Flip_Display_Status --- turn status display on/off            *)
  222. (*----------------------------------------------------------------------*)
  223.  
  224. PROCEDURE Flip_Display_Status;
  225.  
  226. BEGIN (* Flip_Display_Status *)
  227.  
  228.    CASE Display_Status OF
  229.  
  230.       TRUE:   BEGIN
  231.                                    (* Indicate no display   *)
  232.  
  233.                  Display_Status := FALSE;
  234.  
  235.                                    (* Remove XMODEM window  *)
  236.  
  237.                  Restore_Screen( Saved_Screen );
  238.  
  239.                  Reset_Global_Colors;
  240.  
  241.               END;
  242.  
  243.       FALSE:  BEGIN
  244.                                    (* Indicate display will be done *)
  245.  
  246.                  Display_Status := TRUE;
  247.  
  248.                                    (* Save screen image *)
  249.  
  250.                  Save_Screen( Saved_Screen );
  251.  
  252.                                    (* Initialize display window     *)
  253.  
  254.                  Draw_Menu_Frame( 15, 10, 78, 22, Menu_Frame_Color,
  255.                                   Menu_Text_Color, Menu_Title );
  256.  
  257.                  Window( 16, 11, 77, 21 );
  258.  
  259.                                    (* Set up titles *)
  260.  
  261.                  Initialize_Receive_Display;
  262.  
  263.               END;
  264.  
  265.    END (* CASE *);
  266.  
  267. END   (* Flip_Display_Status *);
  268.  
  269. (*----------------------------------------------------------------------*)
  270. (* Update_Xmodem_Receive_Display --- Update display of Xmodem reception *)
  271. (*----------------------------------------------------------------------*)
  272.  
  273. PROCEDURE  Update_Xmodem_Receive_Display;
  274.  
  275. BEGIN (* Update_Xmodem_Receive_Display *)
  276.  
  277.    GoToXY( 25 , 1 );
  278.    WRITE( Sector_Count );
  279.    GoToXY( 25 , 2 );
  280.    WRITE(BlockL_Errors);
  281.    GoToXY( 25 , 3 );
  282.    WRITE(SOH_Errors);
  283.    GoToXY( 25 , 4 );
  284.    WRITE(BlockN_Errors);
  285.    GoToXY( 25 , 5 );
  286.    WRITE(Comple_Errors);
  287.    GoToXY( 25 , 6 );
  288.    WRITE(Timeout_Errors);
  289.    GoToXY( 25 , 7 );
  290.    WRITE(Resend_Errors);
  291.    GoToXY( 25 , 8 );
  292.    WRITE(CRC_Errors);
  293.  
  294.    IF Display_Time THEN
  295.       BEGIN
  296.          GoToXY( 25 , 9 );
  297.          WRITE( TimeString( Time_To_Send ) );
  298.       END;
  299.  
  300. END   (* Update_Xmodem_Receive_Display *);
  301.  
  302. (*----------------------------------------------------------------------*)
  303. (*     Display_Receive_Error --- Display XMODEM reception error         *)
  304. (*----------------------------------------------------------------------*)
  305.  
  306. PROCEDURE  Display_Receive_Error( Err_Text: AnyStr );
  307.  
  308. BEGIN (* Display_Receive_Error *)
  309.  
  310.    IF ( NOT Display_Status ) THEN
  311.       Flip_Display_Status;
  312.  
  313.    GoToXY( 25 , 10 );
  314.    WRITE(Err_Text,' in block ',Sector_Count);
  315.    ClrEol;
  316.    Error_Flag := TRUE;
  317.  
  318. END   (* Display_Receive_Error *);
  319.  
  320. (*----------------------------------------------------------------------*)
  321. (*           Receive_Xmodem_Sector --- Get sector using XMODEM          *)
  322. (*----------------------------------------------------------------------*)
  323.  
  324. FUNCTION Receive_Xmodem_Sector( Use_CRC : BOOLEAN ) : BOOLEAN;
  325.  
  326. (*----------------------------------------------------------------------*)
  327. (*                                                                      *)
  328. (*     Function:   Receive_Xmodem_Sector                                *)
  329. (*                                                                      *)
  330. (*     Purpose:    Gets one sector using XMODEM protocol.               *)
  331. (*                                                                      *)
  332. (*     Calling Sequence:                                                *)
  333. (*                                                                      *)
  334. (*        OK_Get := Receive_Xmodem_Sector( Use_CRC : BOOLEAN )          *)
  335. (*                                       : BOOLEAN;                     *)
  336. (*                                                                      *)
  337. (*           Use_CRC --- TRUE to use Cyclic redundancy check version    *)
  338. (*                       of XMODEM; FALSE to use Checksum version.      *)
  339. (*           OK_Get  --- TRUE if sector received correctly              *)
  340. (*                                                                      *)
  341. (*     Calls:   Async_Send                                              *)
  342. (*              Async_Receive_With_Timeout                              *)
  343. (*              Update_Crc                                              *)
  344. (*              Display_Receive_Error                                   *)
  345. (*                                                                      *)
  346. (*----------------------------------------------------------------------*)
  347.  
  348. VAR
  349.    CRC      : INTEGER;
  350.    Checksum : INTEGER;
  351.    I        : INTEGER;
  352.  
  353. BEGIN (* Receive_Xmodem_Sector *)
  354.  
  355.                                    (* Pick up sector data, calculate *)
  356.                                    (* checksum or CRC                *)
  357.    Receive_Xmodem_Sector := FALSE;
  358.  
  359.    Checksum    := 0;
  360.    CRC         := 0;
  361.                                    (* Sector length is 128 for usual *)
  362.                                    (* Xmodem or Telink; is 1024 for  *)
  363.                                    (* Ymodem.                        *)
  364.    FOR I := 1 TO Sector_Length DO
  365.       BEGIN
  366.                                    (* Get next character *)
  367.  
  368.          Async_Receive_With_Timeout( One_Second , Ch );
  369.  
  370.                                    (* Check for timeout  *)
  371.          IF Ch = TimeOut THEN
  372.             BEGIN
  373.                Display_Receive_Error('Block length error');
  374.                BlockL_Errors := BlockL_Errors + 1;
  375.             END;
  376.  
  377.                                    (* Store received character *)
  378.          Sector_Data[I] := Ch;
  379.                                    (* Update CRC or Checksum   *)
  380.          IF Use_Crc THEN
  381.             CRC := Update_CRC( CRC, Ch )
  382.          ELSE
  383.             Checksum := ( Checksum + Ch ) AND 255;
  384.  
  385.       END;
  386.  
  387.                                    (* Now get trailing CRC or  *)
  388.                                    (* checksum value.          *)
  389.    IF Use_Crc THEN
  390.       BEGIN   (* Receive CRC *)
  391.                                    (* Get first byte of CRC    *)
  392.  
  393.          Async_Receive_With_Timeout( One_Second , Ch );
  394.  
  395.                                    (* Check for timeout        *)
  396.          IF Ch <> Timeout THEN
  397.             BEGIN  (* Byte CRC OK *)
  398.  
  399.                                    (* Update CRC               *)
  400.  
  401.                CRC  := Update_CRC( CRC , Ch );
  402.  
  403.                                    (* Get second byte of CRC   *)
  404.  
  405.                Async_Receive_With_Timeout( One_Second , Ch );
  406.  
  407.                                    (* If not timeout, update CRC *)
  408.                                    (* and check if it is zero.   *)
  409.                                    (* Zero CRC means OK sector.  *)
  410.                IF Ch <> Timeout THEN
  411.                   BEGIN  (* Byte 2 CRC OK *)
  412.  
  413.                      CRC                   := Update_CRC( CRC , Ch );
  414.                      Receive_Xmodem_Sector := ( CRC = 0 );
  415.  
  416.                   END    (* Byte 2 CRC OK *)
  417.                ELSE
  418.                   BEGIN  (* Byte 2 CRC Timeout *)
  419.  
  420.                      Display_Receive_Error('Block length error');
  421.                      BlockL_Errors := BlockL_Errors + 1;
  422.  
  423.                   END    (* Byte 2 CRC Timeout *)
  424.  
  425.             END   (* Byte 1 CRC OK *)
  426.  
  427.          ELSE
  428.             BEGIN (* Byte 1 CRC Timeout *)
  429.  
  430.                Display_Receive_Error('Block length error');
  431.                BlockL_Errors := BlockL_Errors + 1;
  432.  
  433.             END   (* Byte 1 CRC Timeout *);
  434.  
  435.       END     (* Compute CRC *)
  436.  
  437.    ELSE
  438.       BEGIN   (* Receive Checksum *)
  439.  
  440.                                    (* Read sector checksum, see if it matches *)
  441.                                    (* what we computed from sector read.      *)
  442.  
  443.          Async_Receive_With_Timeout( One_Second , Ch );
  444.  
  445.          Receive_Xmodem_Sector := ( Checksum = Ch );
  446.  
  447.       END    (* Receive Checksum *);
  448.  
  449. END   (* Receive_Xmodem_Sector *);
  450.  
  451. (*----------------------------------------------------------------------*)
  452. (*           Receive_Telink_Header --- Get Telink block 0 header        *)
  453. (*----------------------------------------------------------------------*)
  454.  
  455. PROCEDURE Receive_Telink_Header;
  456.  
  457. (*----------------------------------------------------------------------*)
  458. (*                                                                      *)
  459. (*     Procedure:  Receive_Telink_Header                                *)
  460. (*                                                                      *)
  461. (*     Purpose:    Gets Telink header block 0 (filename+size+date)      *)
  462. (*                                                                      *)
  463. (*     Calling Sequence:                                                *)
  464. (*                                                                      *)
  465. (*        Receive_Telink_Header;                                        *)
  466. (*                                                                      *)
  467. (*     Calls:                                                           *)
  468. (*                                                                      *)
  469. (*        Trim                                                          *)
  470. (*        Dir_Convert_Time                                              *)
  471. (*        Dir_Convert_Date                                              *)
  472. (*        Draw_Menu_Frame                                               *)
  473. (*                                                                      *)
  474. (*----------------------------------------------------------------------*)
  475.  
  476. VAR
  477.    I      : INTEGER;
  478.    CDate  : STRING[8];
  479.    CTime  : STRING[8];
  480.  
  481. BEGIN  (* Receive_Telink_Header *)
  482.  
  483.    RFile_Size := 0.0;
  484.    RFile_Name := '';
  485.  
  486.    FOR I := 4 DOWNTO 1 DO
  487.       RFile_Size := RFile_Size * 256.0 + Sector_Data[I];
  488.  
  489.    Blocks_To_Get  := ROUND( RFile_Size / 128.0 + 0.49 );
  490.  
  491.    File_Time := Sector_Data[6] SHL 8 OR Sector_Data[5];
  492.    File_Date := Sector_Data[8] SHL 8 OR Sector_Data[7];
  493.  
  494.    FOR I := 9 TO 24 DO
  495.       IF Sector_Data[I] <> 0 THEN
  496.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  497.  
  498.    RFile_Name := TRIM( Rfile_Name );
  499.  
  500.    Draw_Menu_Frame( 15, 10, 78, 23, Menu_Frame_Color,
  501.                     Menu_Text_Color,
  502.                     'Receive file ' + FileName + ' using ' + Tname );
  503.  
  504.    Dir_Convert_Time( File_Time, CTime );
  505.    Dir_Convert_Date( File_Date, CDate );
  506.  
  507.    Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color,
  508.                     Menu_Text_Color, '' );
  509.  
  510.                                    (* Headings for Telink information *)
  511.    Window( 16, 4, 77, 8 );
  512.  
  513.    GoToXY( 1 , 1 );
  514.    WRITE(' File name:           ',FileName);
  515.    GoToXY( 1 , 2 );
  516.    WRITE(' File Size in bytes:  ',RFile_Size:8:0);
  517.    GoToXY( 1 , 3 );
  518.    WRITE(' File Size in blocks: ',Blocks_To_Get:8:0);
  519.    GoToXY( 1 , 4 );
  520.    WRITE(' File creation time:  ',CTime );
  521.    GoToXY( 1 , 5 );
  522.    WRITE(' File creation date:  ',CDate );
  523.  
  524.                                    (* Restore previous window *)
  525.    Window( 16, 11, 77, 21 );
  526.  
  527.    IF RFile_Size > 0.0 THEN
  528.       BEGIN
  529.  
  530.          Display_Time   := TRUE;
  531.          Time_To_Send   := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate );
  532.          Time_Per_Block := Time_To_Send / Blocks_To_Get;
  533.  
  534.          IF Display_Status THEN
  535.             Initialize_Receive_Display;
  536.  
  537.          Truncate_File  := TRUE;
  538.  
  539.       END;
  540.                                    (* Prevent clobbers in host mode *)
  541.    IF Host_Mode THEN
  542.       Stop_Receive := Stop_Receive OR
  543.                       Scan_Xfer_List( FileName ) OR
  544.                       ( ( LENGTH( FileName ) >= 7 ) AND
  545.                         ( COPY( FileName, 1, 7 ) = 'PIBTERM' ) );
  546.  
  547. END    (* Receive_Telink_Header *);
  548.  
  549. (*----------------------------------------------------------------------*)
  550. (*           Receive_Ymodem_Header --- Get Ymodem block 0 header        *)
  551. (*----------------------------------------------------------------------*)
  552.  
  553. PROCEDURE Receive_Ymodem_Header;
  554.  
  555. (*----------------------------------------------------------------------*)
  556. (*                                                                      *)
  557. (*     Procedure:  Receive_Ymodem_Header                                *)
  558. (*                                                                      *)
  559. (*     Purpose:    Gets Ymodem header block 0 (filename+size+date)      *)
  560. (*                                                                      *)
  561. (*     Calling Sequence:                                                *)
  562. (*                                                                      *)
  563. (*        Receive_Ymodem_Header                                         *)
  564. (*                                                                      *)
  565. (*     Calls:                                                           *)
  566. (*                                                                      *)
  567. (*        Draw_Menu_Frame                                               *)
  568. (*        Dir_Convert_Time                                              *)
  569. (*        Dir_Convert_Date                                              *)
  570. (*        Open_Receiving_File                                           *)
  571. (*                                                                      *)
  572. (*----------------------------------------------------------------------*)
  573.  
  574. VAR
  575.    I     : INTEGER;
  576.    CTime : STRING[10];
  577.    CDate : STRING[10];
  578.    Year  : INTEGER;
  579.    Month : INTEGER;
  580.    Day   : INTEGER;
  581.    Hour  : INTEGER;
  582.    Mins  : INTEGER;
  583.    Secs  : INTEGER;
  584.  
  585. (*----------------------------------------------------------------------*)
  586.  
  587. PROCEDURE Get_Ymodem_Date(     Date  : REAL;
  588.                            VAR Year  : INTEGER;
  589.                            VAR Month : INTEGER;
  590.                            VAR Day   : INTEGER;
  591.                            VAR Hour  : INTEGER;
  592.                            VAR Mins  : INTEGER;
  593.                            VAR Secs  : INTEGER );
  594.  
  595. CONST
  596.    Secs_Per_Year      = 31536000.0;
  597.    Secs_Per_Leap_Year = 31622400.0;
  598.    Secs_Per_Day       = 86400.0;
  599.    Secs_Per_Hour      = 3600.0;
  600.    Secs_Per_Minute    = 60.0;
  601.  
  602. VAR
  603.    RDate     : REAL;
  604.    T         : REAL;
  605.  
  606. (* STRUCTURED *) CONST
  607.    Days_Per_Month : ARRAY[1..12] OF BYTE
  608.                     = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
  609.  
  610. BEGIN (* Get_Ymodem_Date *)
  611.  
  612.    Year  := 1970;
  613.    Month := 1;
  614.  
  615.    RDate := Date - GMT_Difference * Secs_Per_Hour;
  616.  
  617.    WHILE( RDate > 0.0 ) DO
  618.       BEGIN
  619.  
  620.          IF ( Year MOD 4 ) = 0 THEN
  621.             T := Secs_Per_Leap_Year
  622.          ELSE
  623.             T := Secs_Per_Year;
  624.  
  625.          RDate := RDate - T;
  626.          Year  := Year  + 1;
  627.  
  628.       END;
  629.  
  630.    RDate := RDate + T;
  631.    Year  := Year  - 1;
  632.  
  633.    IF ( Year MOD 4 ) = 0 THEN
  634.       Days_Per_Month[2] := 29
  635.    ELSE
  636.       Days_Per_Month[2] := 28;
  637.  
  638.    WHILE( RDate > 0.0 ) DO
  639.       BEGIN
  640.  
  641.          T     := Days_Per_Month[Month] * Secs_Per_Day;
  642.  
  643.          RDate := RDate - T;
  644.          Month := Month + 1;
  645.  
  646.       END;
  647.  
  648.    RDate := RDate + T;
  649.    Month := Month - 1;
  650.  
  651.    Day   := TRUNC( INT( ( Rdate + Secs_Per_Day - 1 ) / Secs_Per_Day  ) );
  652.    Rdate := Rdate - ( Day - 1 ) * Secs_Per_Day;
  653.  
  654.    Hour  := TRUNC( INT( Rdate / Secs_Per_Hour ) );
  655.    Rdate := Rdate - Hour * Secs_Per_Hour;
  656.  
  657.    Mins  := TRUNC( INT( Rdate / Secs_Per_Minute ) );
  658.    Secs  := TRUNC( Rdate - Mins * Secs_Per_Minute );
  659.  
  660. END   (* Get_Ymodem_Date *);
  661.  
  662. (*----------------------------------------------------------------------*)
  663.  
  664. BEGIN  (* Receive_Ymodem_Header *)
  665.  
  666.    RFile_Size := 0.0;
  667.    RFile_Date := 0.0;
  668.    RFile_Name := '';
  669.    File_Time  := 0;
  670.    File_Date  := 0;
  671.                                    (* Pick up file name *)
  672.    I := 1;
  673.    WHILE( Sector_Data[I] <> NUL ) DO
  674.       BEGIN
  675.          RFile_Name := RFile_Name + CHR( Sector_Data[I] );
  676.          I          := I + 1;
  677.       END;
  678.                                   (* If null file name, this means *)
  679.                                   (* end of Ymodem batch, so quit. *)
  680.    IF LENGTH( RFile_Name ) = 0 THEN
  681.       BEGIN
  682.          Null_File_Name := TRUE;
  683.          EXIT;
  684.       END;
  685.                                   (* Pick up file size *)
  686.    I := I + 1;
  687.  
  688.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  689.       BEGIN
  690.          RFile_Size := RFile_Size * 10.0 + ORD( Sector_Data[I] ) - ORD('0');
  691.          I          := I + 1;
  692.       END;
  693.  
  694.    I := I + 1;
  695.  
  696.    WHILE( Sector_Data[I] <> NUL ) AND ( Sector_Data[I] <> ORD(' ') ) DO
  697.       BEGIN
  698.          RFile_Date := RFile_Date * 8.0 + ORD( Sector_Data[I] ) - ORD('0');
  699.          I          := I + 1;
  700.       END;
  701.  
  702.    IF RFile_Date > 0 THEN
  703.       BEGIN
  704.  
  705.          Get_Ymodem_Date( RFile_Date, Year, Month, Day, Hour, Mins, Secs );
  706.  
  707.          File_Time := Hour SHL 11 OR Mins SHL 5 OR ( Secs DIV 2 );
  708.          File_Date := MAX( Year - 1980 , 0 ) SHL 9 + Month SHL 5 + Day;
  709.  
  710.          Dir_Convert_Time( File_Time, CTime );
  711.          Dir_Convert_Date( File_Date, CDate );
  712.  
  713.       END;
  714.  
  715.    Draw_Menu_Frame( 15, 3, 78, 9, Menu_Frame_Color,
  716.                     Menu_Text_Color,
  717.                     'Receive file ' + RFile_Name + ' using ' + Tname );
  718.  
  719.                                    (* Headings for Ymodem information *)
  720.    Window( 16, 4, 77, 8 );
  721.  
  722.    GoToXY( 1 , 1 );
  723.    WRITE(' File name:              ',RFile_Name);
  724.  
  725.    Blocks_To_Get  := ROUND( RFile_Size / 1024.0 + 0.49 );
  726.  
  727.    IF RFile_Size > 0.0 THEN
  728.       BEGIN
  729.          GoToXY( 1 , 2 );
  730.          WRITE(' File Size in bytes:     ',RFile_Size:8:0);
  731.          GoToXY( 1 , 3 );
  732.          WRITE(' File Size in 1K blocks: ',Blocks_To_Get:8:0);
  733.       END;
  734.  
  735.    Blocks_To_Get  := ROUND( RFile_Size / 128.0 + 0.49 );
  736.  
  737.    IF File_Date > 0 THEN
  738.       BEGIN
  739.          GoToXY( 1 , 4 );
  740.          WRITE(' File creation time:     ',CTime );
  741.          GoToXY( 1 , 5 );
  742.          WRITE(' File creation date:     ',CDate );
  743.       END;
  744.  
  745.    FileName := RFile_Name;
  746.                                    (* Restore previous window *)
  747.    Window( 16, 11, 77, 21 );
  748.  
  749.    IF Rfile_Size > 0.0 THEN
  750.       BEGIN
  751.  
  752.          Display_Time   := TRUE;
  753.          Time_To_Send   := Blocks_To_Get * ( Trans_Time_Val / Baud_Rate );
  754.          Time_Per_Block := Time_To_Send / Blocks_To_Get;
  755.  
  756.          IF Display_Status THEN
  757.             Initialize_Receive_Display;
  758.  
  759.          Truncate_File  := ( RFile_Size > 0.0 );
  760.  
  761.       END;
  762.                                    (* Prevent clobbers in host mode *)
  763.    IF Host_Mode THEN
  764.       Stop_Receive := Stop_Receive OR
  765.                       Scan_Xfer_List( FileName ) OR
  766.                       ( ( LENGTH( FileName ) >= 7 ) AND
  767.                         ( COPY( FileName, 1, 7 ) = 'PIBTERM' ) );
  768.  
  769.                                    (* Open reception file     *)
  770.    IF ( NOT Stop_Receive ) THEN
  771.       Open_Receiving_File;
  772.  
  773. END    (* Receive_Ymodem_Header *);
  774.  
  775.  
  776. (*----------------------------------------------------------------------*)
  777. (*        Wait_For_SOH --- Wait for start for start of XMODEM block     *)
  778. (*----------------------------------------------------------------------*)
  779.  
  780. PROCEDURE Wait_For_SOH(     Wait_Time    : INTEGER;
  781.                         VAR Initial_Ch   : INTEGER;
  782.                         VAR Stop_Receive : BOOLEAN  );
  783.  
  784. (*----------------------------------------------------------------------*)
  785. (*                                                                      *)
  786. (*     Procedure:  Wait_For_SOH                                         *)
  787. (*                                                                      *)
  788. (*     Purpose:    Waits for SOH/STX/SYN initiating Xmodem block        *)
  789. (*                                                                      *)
  790. (*     Calling Sequence:                                                *)
  791. (*                                                                      *)
  792. (*        Wait_For_SOH(     Wait_Time    : INTEGER;                     *)
  793. (*                      VAR Initial_Ch   : INTEGER;                     *)
  794. (*                      VAR Stop_Receive : BOOLEAN );                   *)
  795. (*                                                                      *)
  796. (*           Wait_Time    --- time to wait for character in seconds     *)
  797. (*           Initial_Ch   --- returned initial character                *)
  798. (*           Stop_Receive --- TRUE if Alt-R hit to stop transfer        *)
  799. (*                                                                      *)
  800. (*     Calls:                                                           *)
  801. (*                                                                      *)
  802. (*        Async_Receive_With_Timeout                                    *)
  803. (*                                                                      *)
  804. (*----------------------------------------------------------------------*)
  805.  
  806. VAR
  807.    Kbd_Ch: CHAR;
  808.    ITime : INTEGER;
  809.  
  810. BEGIN  (* Wait_For_SOH *)
  811.                                    (* If already cancelled transfer, *)
  812.                                    (* don't look for more input!     *)
  813.    Initial_Ch := TimeOut;
  814.  
  815.    IF Stop_Receive THEN EXIT;
  816.  
  817.                                    (* Look for start of Xmodem block *)
  818.    ITime := 0;
  819.  
  820.    REPEAT
  821.  
  822.       ITime := ITime + 1;
  823.  
  824.       Async_Receive_With_Timeout( One_Second, Initial_Ch );
  825.  
  826.                                    (* Check for keyboard input -- Alt_R *)
  827.                                    (* cancels transfer.                 *)
  828.       IF KeyPressed THEN
  829.          BEGIN
  830.             READ( Kbd, Kbd_Ch );
  831.             IF ( Kbd_Ch = CHR( ESC ) ) AND KeyPressed THEN
  832.                BEGIN
  833.                    READ( Kbd, Kbd_Ch );
  834.                    Alt_R_Pressed  := ( ORD( Kbd_Ch ) = Alt_R );
  835.                    IF ORD( Kbd_Ch ) = Alt_1 THEN
  836.                       Flip_Display_Status;
  837.                    Stop_Receive   := Stop_Receive OR Alt_R_Pressed;
  838.                END;
  839.          END;
  840.                                    (* Also stop transfer if carrier drops *)
  841.  
  842.       IF Async_Carrier_Drop THEN
  843.          BEGIN
  844.             Stop_Receive := TRUE;
  845.             Initial_Ch   := TimeOut;
  846.          END;
  847.  
  848.    UNTIL ( Stop_Receive          OR
  849.            ( ITime > Wait_Time ) OR
  850.            ( Initial_Ch <> TimeOut ) );
  851.  
  852. END    (* Wait_For_SOH *);
  853.  
  854. (*----------------------------------------------------------------------*)
  855. (*       Set_File_Date_And_Time --- set file date and time stamp        *)
  856. (*----------------------------------------------------------------------*)
  857.  
  858. PROCEDURE Set_File_Date_And_Time;
  859.  
  860. VAR
  861.    OLd_Time   : INTEGER;
  862.    Old_Date   : INTEGER;
  863.    Err        : INTEGER;
  864.    File_Handle: INTEGER;
  865.  
  866. (*----------------------------------------------------------------------*)
  867.  
  868. PROCEDURE Set_File_Time_Error;
  869.  
  870. BEGIN (* Set_File_Time_Error *)
  871.  
  872.    IF ( NOT Display_Status ) THEN
  873.       Flip_Display_Status;
  874.  
  875.    GoToXY( 25 , 10 );
  876.    WRITE('Could not set date/time for file.');
  877.    ClrEol;
  878.  
  879.    DELAY( One_Second_Delay );
  880.  
  881. END   (* Set_File_Time_Error *);
  882.  
  883. (*----------------------------------------------------------------------*)
  884.  
  885. BEGIN (* Set_File_Date_And_Time *)
  886.  
  887.    Err  := Open_File_Handle( FileName, Access_Read_And_Write_Mode,
  888.                              File_Handle );
  889.  
  890.    IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  891.       Set_File_Time_Error
  892.    ELSE
  893.       BEGIN
  894.  
  895.          Err  := Dir_Set_File_Date_And_Time( File_Handle, File_Date,
  896.                                              File_Time );
  897.  
  898.          IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  899.             Set_File_Time_Error
  900.          ELSE
  901.             BEGIN
  902.  
  903.                Err  := Close_File_Handle( File_Handle );
  904.  
  905.                IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  906.                   Set_File_Time_Error;
  907.  
  908.             END;
  909.  
  910.       END;
  911.  
  912. END   (* Set_File_Date_And_Time *);
  913.  
  914. (*----------------------------------------------------------------------*)
  915. (*             Write_File_Data --- Write received data to file          *)
  916. (*----------------------------------------------------------------------*)
  917.  
  918. PROCEDURE Write_File_Data;
  919.  
  920. PROCEDURE Do_Actual_Write( Write_Count: INTEGER );
  921.  
  922. BEGIN (* Do_Actual_Write *)
  923.  
  924.    IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND Truncate_File THEN
  925.       Write_Count := TRUNC( RFile_Size - Rfile_Size_2 );
  926.  
  927.    Err := Write_File_Handle( XFile_Handle, Write_Buffer^, Write_Count );
  928.  
  929.    IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  930.       BEGIN
  931.  
  932.          IF ( NOT Display_Status ) THEN
  933.             Flip_Display_Status;
  934.  
  935.          GoToXY( 25 , 10 );
  936.          WRITE('Error in writing to disk, transfer cancelled.');
  937.          ClrEol;
  938.          DELAY( One_Second_Delay );
  939.          Stop_Receive := TRUE;
  940.       END;
  941.  
  942.    RFile_Size_2 := RFile_Size_2 + Write_Count;
  943.  
  944. END   (* Do_Actual_Write *);
  945.  
  946. (*----------------------------------------------------------------------*)
  947.  
  948. BEGIN (* Write_File_Data *)
  949.                                    (* Write directly from sector *)
  950.                                    (* if not long buffer used    *)
  951.    IF ( NOT Long_Buffer ) THEN
  952.       Do_Actual_Write( Sector_Length )
  953.  
  954.                                    (* Store sector data in long  *)
  955.                                    (* buffer and write file if   *)
  956.                                    (* necessary.                 *)
  957.  
  958.    ELSE
  959.       BEGIN
  960.  
  961.          IF ( Buffer_Pos + Sector_Length ) > Buffer_Length THEN
  962.             BEGIN
  963.                Do_Actual_Write( Buffer_Pos );
  964.                Buffer_Pos   := 0;
  965.             END;
  966.  
  967.          MOVE( Sector_Data, Write_Buffer^[ Buffer_Pos + 1 ], Sector_Length );
  968.  
  969.          Buffer_Pos := Buffer_Pos + Sector_Length;
  970.  
  971.       END;
  972.  
  973. END   (* Write_File_Data *);
  974.  
  975. (*----------------------------------------------------------------------*)
  976. (*             Cancel_Transfer --- Cancel transfer                      *)
  977. (*----------------------------------------------------------------------*)
  978.  
  979. PROCEDURE Cancel_Transfer;
  980.  
  981. BEGIN (* Cancel_Transfer *)
  982.  
  983.                                    (* Purge reception *)
  984.    Async_Purge_Buffer;
  985.                                    (* Send five cancels, then five *)
  986.                                    (* backspaces.                  *)
  987.  
  988.    Async_Send( CHR( CAN ) );
  989.    Async_Send( CHR( CAN ) );
  990.    Async_Send( CHR( CAN ) );
  991.    Async_Send( CHR( CAN ) );
  992.    Async_Send( CHR( CAN ) );
  993.  
  994.    Async_Send( CHR( BS  ) );
  995.    Async_Send( CHR( BS  ) );
  996.    Async_Send( CHR( BS  ) );
  997.    Async_Send( CHR( BS  ) );
  998.    Async_Send( CHR( BS  ) );
  999.  
  1000. END   (* Cancel_Transfer *);
  1001.  
  1002. (*----------------------------------------------------------------------*)
  1003.  
  1004. BEGIN  (* Receive_Xmodem_File *)
  1005.                                    (* Open display window for transfer  *)
  1006.    Save_Screen( Saved_Screen );
  1007.  
  1008.    CASE Transfer_Protocol OF
  1009.       Xmodem_Chk   : Tname := 'Xmodem (Checksum)';
  1010.       Xmodem_Crc   : Tname := 'Xmodem (CRC)';
  1011.       Telink       : Tname := 'Telink';
  1012.       Modem7_Chk   : Tname := 'Modem7 (Checksum)';
  1013.       Modem7_CRC   : Tname := 'Modem7 (CRC)';
  1014.       Ymodem       : Tname := 'Ymodem';
  1015.       Ymodem_Batch : Tname := 'Ymodem Batch';
  1016.    END (* CASE *);
  1017.  
  1018.    IF FileName = '' THEN
  1019.       Menu_Title := 'Receive file using ' + Tname
  1020.    ELSE
  1021.       Menu_Title := 'Receive file ' + FileName + ' using ' + Tname;
  1022.  
  1023.    Draw_Menu_Frame( 15, 10, 78, 22, Menu_Frame_Color,
  1024.                     Menu_Text_Color, Menu_Title );
  1025.  
  1026.    Window( 16, 11, 77, 21 );
  1027.                                    (* Initialize status display information *)
  1028.    SOH_Errors     := 0;
  1029.    BlockL_Errors  := 0;
  1030.    BlockN_Errors  := 0;
  1031.    Comple_Errors  := 0;
  1032.    Timeout_Errors := 0;
  1033.    Resend_Errors  := 0;
  1034.    CRC_Errors     := 0;
  1035.    Display_Time   := FALSE;
  1036.  
  1037.    Initialize_Receive_Display;
  1038.                                    (* Current sector = 0 *)
  1039.    Sector_Number  := 0;
  1040.    Sector_Count   := 0;
  1041.    Sector_Prev    := 0;
  1042.    Sector_Length  := 128;
  1043.                                    (* Overall error count = 0 *)
  1044.    Error_Count    := 0;
  1045.                                    (* CRC tries *)
  1046.    CRC_Tries      := 0;
  1047.                                    (* How long to wait for SOH *)
  1048.    SOH_Time       := Ten_Seconds;
  1049.                                    (* Assume file size not sent *)
  1050.    Truncate_File  := FALSE;
  1051.                                    (* Assume file size, date not sent *)
  1052.    RFile_Size     := 0.0;
  1053.    RFile_Size_2   := 0.0;
  1054.    RFile_Date     := 0.0;
  1055.    File_Date      := 0;
  1056.    File_Time      := 0;
  1057.                                    (* Assume file name not sent *)
  1058.    RFile_Name     := '';
  1059.                                    (* Assume transfer fails *)
  1060.    OK_Transfer    := FALSE;
  1061.                                    (* Assume block 0 not found *)
  1062.    Block_Zero     := FALSE;
  1063.                                    (* Starting time  *)
  1064.    Start_Time     := TimeOfDay;
  1065.                                    (* User intervention flag *)
  1066.    Alt_R_Pressed  := FALSE;
  1067.                                    (* Serious error flag     *)
  1068.    Stop_Receive   := FALSE;
  1069.                                    (* Not null file name   *)
  1070.    Null_File_Name := FALSE;
  1071.                                    (* Allocate buffer if requested   *)
  1072.                                    (* otherwise use sector data area *)
  1073.                                    (* directly.                      *)
  1074.  
  1075.    IF ( Max_Write_Buffer > 1024 ) AND
  1076.       ( Max_Write_Buffer < MaxBlockAvail ) THEN
  1077.       BEGIN
  1078.          Buffer_Length  := Max_Write_Buffer;
  1079.          Long_Buffer    := TRUE;
  1080.          GetMem( Write_Buffer , Buffer_Length );
  1081.       END
  1082.    ELSE
  1083.       BEGIN
  1084.          Long_Buffer   := FALSE;
  1085.          Buffer_Length := 1024;
  1086.          Write_Buffer  := ADDR( Sector_Data );
  1087.       END;
  1088.                                    (* Empty write buffer   *)
  1089.    Buffer_Pos     := 0;
  1090.                                    (* Open reception file now if possible *)
  1091.    RFile_Open     := FALSE;
  1092.  
  1093.    IF FileName <> '' THEN
  1094.       BEGIN
  1095.          Open_Receiving_File;
  1096.          IF Stop_Receive THEN
  1097.             BEGIN
  1098.                Cancel_Transfer;
  1099.                DELAY( Two_Second_Delay );
  1100.                Restore_Screen( Saved_Screen );
  1101.                Reset_Global_Colors;
  1102.                EXIT;
  1103.             END;
  1104.       END;
  1105.  
  1106.                                    (* Begin XMODEM loop    *)
  1107.    REPEAT
  1108.                                    (* Reset error flag *)
  1109.       Error_flag := FALSE;
  1110.                                    (* Look for SOH     *)
  1111.       REPEAT
  1112.  
  1113.          IF Sector_Count = 0 THEN
  1114.             BEGIN
  1115.  
  1116.                Use_CRC := Use_CRC AND ( CRC_Tries < 4 );
  1117.  
  1118.                                    (* Purge reception      *)
  1119.                Async_Purge_Buffer;
  1120.                                    (* Indicate XMODEM type *)
  1121.                IF Use_Crc THEN
  1122.                   Async_Send( 'C' )
  1123.                ELSE
  1124.                   Async_Send( CHR( NAK ) );
  1125.  
  1126.                CRC_Tries := CRC_Tries + 1;
  1127.  
  1128.                IF Display_Status THEN
  1129.                   BEGIN
  1130.  
  1131.                      GoToXY( 1 , 8 );
  1132.  
  1133.                      IF ( NOT Use_Crc ) THEN
  1134.                         WRITELN(' Checksum errors      :')
  1135.                      ELSE
  1136.                         WRITELN(' CRC errors           :');
  1137.  
  1138.                   END;
  1139.  
  1140.             END;
  1141.  
  1142.          Wait_For_SOH( SOH_Time, Initial_Ch , Stop_Receive );
  1143.  
  1144.                                    (* If CAN found, insist on    *)
  1145.                                    (* at least two CANs in a row *)
  1146.                                    (* before cancelling transfer *)
  1147.  
  1148.          IF Initial_Ch = CAN THEN
  1149.             Wait_For_SOH( SOH_Time, Initial_Ch , Stop_Receive );
  1150.  
  1151.       UNTIL ( Initial_Ch = SOH         ) OR
  1152.             ( Initial_Ch = EOT         ) OR
  1153.             ( Initial_Ch = CAN         ) OR
  1154.             ( Initial_Ch = SYN         ) OR
  1155.             ( Initial_Ch = STX         ) OR
  1156.             ( Initial_Ch = TimeOut     ) OR
  1157.             ( Error_Count > Max_Errors ) OR
  1158.             ( Stop_Receive             );
  1159.  
  1160.                                    (* Something wrong already -- *)
  1161.                                    (* cancel the transfer.       *)
  1162.       IF Stop_Receive THEN
  1163.          BEGIN
  1164.             IF NOT Async_Carrier_Detect THEN
  1165.                BEGIN
  1166.                   Display_Receive_Error('Carrier dropped.');
  1167.                   DELAY( Two_Second_Delay );
  1168.                END;
  1169.          END
  1170.                                    (* Timed out -- no SOH found *)
  1171.  
  1172.       ELSE IF Initial_Ch = Timeout THEN
  1173.          BEGIN
  1174.             Display_Receive_Error( 'Time out error, no SOH');
  1175.             Timeout_Errors := Timeout_Errors + 1;
  1176.          END
  1177.                                    (* SYN found -- Telink header         *)
  1178.                                    (* SOH found -- start of XMODEM block *)
  1179.                                    (* STX found -- start of Ymodem block *)
  1180.  
  1181.       ELSE IF ( Initial_Ch = SOH ) OR
  1182.               ( Initial_Ch = SYN ) OR
  1183.               ( Initial_Ch = STX ) THEN
  1184.          BEGIN (* SOH found *)
  1185.                                    (* Pick up sector number *)
  1186.  
  1187.             IF Initial_Ch = STX THEN
  1188.                Sector_Length := 1024
  1189.             ELSE
  1190.                Sector_Length := 128;
  1191.  
  1192.             Async_Receive_With_Timeout( One_Second , Ch );
  1193.  
  1194.             IF Ch = TimeOut THEN
  1195.                BEGIN
  1196.                   BlockL_Errors := BlockL_Errors + 1;
  1197.                   Display_Receive_Error('Short block');
  1198.                END;
  1199.  
  1200.             Sector_Number := Ch;
  1201.  
  1202.                                    (* Complement of sector number *)
  1203.  
  1204.             Async_Receive_With_Timeout( One_Second , Ch );
  1205.  
  1206.             IF Ch = TimeOut THEN
  1207.                BEGIN
  1208.                   BlockL_Errors := BlockL_Errors + 1;
  1209.                   Display_Receive_Error('Short block');
  1210.                END;
  1211.  
  1212.             Sector_Comp := Ch;
  1213.                                    (* See if they add up properly     *)
  1214.  
  1215.             IF ( ( Sector_Number + Sector_Comp ) = 255 ) THEN
  1216.  
  1217.                BEGIN  (* Sector number and complement match *)
  1218.  
  1219.                   Sector_Prev1 := Sector_Prev + 1;
  1220.  
  1221.                   Block_Zero   := ( Sector_Count  = 0 ) AND
  1222.                                   ( Sector_Number = 0 ) AND
  1223.                                   ( ( Initial_Ch  = SYN ) OR
  1224.                                     ( Transfer_Protocol IN [Ymodem,
  1225.                                                             Ymodem_Batch] ) );
  1226.  
  1227.                   IF ( Sector_Number = Sector_Prev1 ) OR Block_Zero THEN
  1228.                      BEGIN  (* Correct sector found *)
  1229.  
  1230.                         Use_CRC_2 := Use_CRC AND
  1231.                                      ( NOT ( Block_Zero AND
  1232.                                              ( Transfer_Protocol = Telink ) ) );
  1233.  
  1234.                         IF Receive_Xmodem_Sector( Use_CRC_2 ) THEN
  1235.                            IF ( NOT Block_Zero ) THEN
  1236.                               BEGIN (* Checksum/CRC OK *)
  1237.  
  1238.                                  Write_File_Data;
  1239.  
  1240.                                  Error_Count  := 0;
  1241.  
  1242.                                  Sector_Count := Sector_Count + 1;
  1243.  
  1244.                                  Sector_Prev := Sector_Number;
  1245.  
  1246.                                  Async_Send( CHR( ACK ) );
  1247.  
  1248.                               END   (* Checksum/CRC OK *)
  1249.                            ELSE (* Telink/Ymodem block 0 *)
  1250.                               BEGIN
  1251.  
  1252.                                  IF ( Initial_Ch = SYN ) THEN
  1253.                                     Receive_Telink_Header
  1254.                                  ELSE IF ( Transfer_Protocol IN [Ymodem,
  1255.                                                           Ymodem_Batch] ) THEN
  1256.                                     Receive_Ymodem_Header;
  1257.  
  1258.                                  IF ( NOT Stop_Receive ) THEN
  1259.                                     BEGIN
  1260.                                        Async_Send( CHR( ACK ) );
  1261.                                        Error_Count := 0;
  1262.                                     END;
  1263.  
  1264.                               END
  1265.                         ELSE
  1266.                            BEGIN  (* Checksum/CRC error *)
  1267.                               CRC_Errors := CRC_Errors + 1;
  1268.                               IF Use_Crc THEN
  1269.                                  Display_Receive_Error('CRC error')
  1270.                               ELSE
  1271.                                  Display_Receive_Error('Checksum error');
  1272.                            END    (* Checksum/CRC error *)
  1273.  
  1274.                      END  (* Correct sector found *)
  1275.  
  1276.                   ELSE
  1277.                      IF ( Sector_Number = Sector_Prev ) THEN
  1278.                         BEGIN  (* Duplicate sector *)
  1279.  
  1280.                            Display_Receive_Error('Duplicate block ');
  1281.  
  1282.                            Resend_Errors := Resend_Errors + 1;
  1283.  
  1284.                            Async_Send( CHR( ACK ) );
  1285.  
  1286.                         END   (* Duplicate sector *)
  1287.                   ELSE
  1288.                      BEGIN
  1289.                         Display_Receive_Error('Synchronization error');
  1290.                         BlockN_Errors := BlockN_Errors + 1;
  1291.                      END;
  1292.  
  1293.                END   (* Sector # and complement match *)
  1294.  
  1295.             ELSE
  1296.                BEGIN (* Sector # and complement do not match *)
  1297.                   Display_Receive_Error('Sector number error');
  1298.                   Comple_Errors := Comple_Errors + 1;
  1299.                END   (* Sector # and complement do not match *);
  1300.  
  1301.          END (* SOH Found *)
  1302.       ELSE IF ( Initial_Ch <> EOT ) THEN
  1303.          BEGIN
  1304.             Display_Receive_Error('SOH not found');
  1305.             SOH_Errors := SOH_Errors + 1;
  1306.          END;
  1307.  
  1308.       IF Error_Flag THEN
  1309.          BEGIN
  1310.             Error_Count := Error_Count + 1;
  1311.             Async_Purge_Buffer;
  1312.             Async_Send( CHR( NAK ) );
  1313.          END;
  1314.  
  1315.       IF Display_Time THEN
  1316.          BEGIN
  1317.  
  1318.             IF ( NOT Error_Flag ) THEN
  1319.                Time_To_Send := Time_To_Send -
  1320.                                Time_Per_Block * ( Sector_Length / 128 );
  1321.  
  1322.             IF Time_To_Send < 0.0 THEN
  1323.                Time_To_Send := 0.0;
  1324.  
  1325.          END;
  1326.  
  1327.       IF Display_Status THEN
  1328.          Update_Xmodem_Receive_Display;
  1329.  
  1330.    UNTIL ( Initial_Ch = EOT     ) OR
  1331.          ( Initial_Ch = CAN     ) OR
  1332.          ( Stop_Receive         ) OR
  1333.          ( Null_File_Name       ) OR
  1334.          ( Error_Count > Max_Errors );
  1335.  
  1336.                                    (* If serious error or Alt_R hit, *)
  1337.                                    (* stop download.                 *)
  1338.    IF ( Stop_Receive ) THEN
  1339.       BEGIN
  1340.  
  1341.          Cancel_Transfer;
  1342.  
  1343.          IF Alt_R_Pressed THEN
  1344.             BEGIN
  1345.                IF ( NOT Display_Status ) THEN
  1346.                   Flip_Display_Status;
  1347.                GoToXY( 25 , 10 );
  1348.                WRITE('Alt-R key hit -- reception cancelled.');
  1349.                Writelne('ALT-R key hit, reception cancelled.', FALSE);
  1350.                ClrEol;
  1351.             END;
  1352.  
  1353.       END
  1354.                                    (* Null file name -- end of batch *)
  1355.    ELSE IF Null_File_Name THEN
  1356.       BEGIN
  1357.          IF ( NOT Display_Status ) THEN
  1358.             Flip_Display_Status;
  1359.          GoToXY( 25 , 10 );
  1360.          WRITE('Null file name received.');
  1361.          Writelne('Null file name received.', FALSE);
  1362.          ClrEol;
  1363.       END
  1364.                                    (* EOT received, error count OK *)
  1365.  
  1366.    ELSE IF ( Initial_Ch = EOT ) AND ( Error_Count <= Max_Errors ) THEN
  1367.       BEGIN
  1368.                                    (* Acknowledge EOT  *)
  1369.          Async_Send( CHR( ACK ) );
  1370.  
  1371.                                    (* Write any remaining data in buffer *)
  1372.          IF Buffer_Pos > 0 THEN
  1373.             BEGIN
  1374.  
  1375.                Write_Count := Buffer_Pos;
  1376.  
  1377.                IF ( ( RFile_Size_2 + Write_Count ) > RFile_Size ) AND
  1378.                    Truncate_File THEN
  1379.                       Write_Count := TRUNC( RFile_Size - Rfile_Size_2 );
  1380.  
  1381.                Err := Write_File_Handle( XFile_Handle, Write_Buffer^, Write_Count );
  1382.  
  1383.                IF ( Err <> 0 ) OR ( Int24Result <> 0 ) THEN
  1384.                   BEGIN
  1385.                      IF ( NOT Display_Status ) THEN
  1386.                         Flip_Display_Status;
  1387.                      GoToXY( 25 , 10 );
  1388.                      WRITE('Error in writing to disk, file may be bad.');
  1389.                      ClrEol;
  1390.                      DELAY( One_Second_Delay );
  1391.                   END;
  1392.  
  1393.                RFile_Size_2 := RFile_Size_2 + Write_Count;
  1394.  
  1395.             END;
  1396.  
  1397.          IF ( NOT Display_Status ) THEN
  1398.             Flip_Display_Status;
  1399.  
  1400.          GoToXY( 2 , 10 );
  1401.          WRITE('Transfer complete; ');
  1402.  
  1403.          End_Time       := TimeOfDay;
  1404.  
  1405.          IF RFile_Size > 0.0 THEN
  1406.             IF RFile_Size <= RFile_Size_2 THEN
  1407.                RFile_Size_2 := RFile_Size;
  1408.  
  1409.          IF End_Time > Start_Time THEN
  1410.             BEGIN
  1411.  
  1412.                Effective_Rate := RFile_Size_2 / ( End_Time - Start_Time );
  1413.  
  1414.                WRITE('transfer rate was ',Effective_Rate:6:1,' CPS');
  1415.                ClrEol;
  1416.  
  1417.                OK_Transfer := TRUE;
  1418.  
  1419.             END;
  1420.  
  1421.          Writelne('Received file ' + FileName , FALSE );
  1422.          STR( Effective_Rate:6:1 , TName );
  1423.          Writelne('  Transfer rate was ' + TName + ' CPS' , FALSE );
  1424.  
  1425.       END
  1426.    ELSE IF ( Initial_Ch = CAN ) THEN
  1427.       BEGIN
  1428.          IF ( NOT Display_Status ) THEN
  1429.             Flip_Display_Status;
  1430.          GoToXY( 25 , 10 );
  1431.          WRITE('Transmitter cancelled file transfer.');
  1432.          Writelne('Transmitter cancelled file transfer.', FALSE);
  1433.          ClrEol;
  1434.       END
  1435.    ELSE
  1436.       BEGIN
  1437.          IF ( NOT Display_Status ) THEN
  1438.             Flip_Display_Status;
  1439.          GoToXY( 25 , 10 );
  1440.          WRITE('Transfer Cancelled');
  1441.          Writelne('Transfer cancelled', FALSE);
  1442.          ClrEol;
  1443.       END;
  1444.                                    (* Close transferred file *)
  1445.  
  1446.    Err := Close_File_Handle( XFile_Handle );
  1447.    I   := Int24Result;
  1448.                                    (* Set file time and date if Telink *)
  1449.                                    (* or Ymodem                        *)
  1450.  
  1451.    IF ( File_Date > 0 ) AND Use_Time_Sent THEN
  1452.       Set_File_Date_And_Time;
  1453.  
  1454.    DELAY( Two_Second_Delay );
  1455.                                    (* Remove download buffer           *)
  1456.  
  1457.    IF Long_Buffer THEN
  1458.       FREEMEM( Write_Buffer , Buffer_Length );
  1459.  
  1460.                                    (* Remove XMODEM window             *)
  1461.    Restore_Screen( Saved_Screen );
  1462.  
  1463.    Reset_Global_Colors;
  1464.  
  1465. END    (* Receive_Xmodem_File *) ;
  1466.